home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / madtrb38.arc / HORSERAC.PAS < prev    next >
Pascal/Delphi Source File  |  1985-01-20  |  4KB  |  189 lines
  1. program horserace (input, output);
  2.  
  3. const
  4.    maxplayer = 10;
  5.    maxhorses = 12;  (* each player has 12 horses *)
  6.  
  7. type
  8.    horse = record
  9.       horseloc : 0..10;
  10.       togo     : 0..10;
  11.    end;
  12.  
  13. var
  14.    track : array[1..maxplayer, 1..maxhorses] of horse;
  15.    numplayers : integer;
  16.    curplayer  : 1..maxplayer;
  17.    win        : boolean;
  18.    i,j        : integer;
  19.  
  20. procedure getnumplayers;
  21.  
  22. begin
  23.    write('How many players? ');
  24.    readln(numplayers);
  25.    while (numplayers <= 0) or (numplayers > maxplayer) do
  26.    begin
  27.       writeln('Sorry, only numbers between 1 and ',maxplayer,' are allowed.');
  28.       write('How many players? ');
  29.       readln(numplayers)
  30.    end
  31. end;
  32.  
  33. (*
  34.  * maketracks
  35.  * initializes track.togo to the correct
  36.  * handicaps, and track.horseloc to 0 to start
  37.  * the game.
  38.  *)
  39.  
  40. procedure maketracks;
  41.  
  42. begin
  43.    for i := 1 to numplayers do
  44.    begin
  45.       track[i,1].togo := 4;
  46.       track[i,2].togo := 6;
  47.       track[i,3].togo := 6;
  48.       track[i,4].togo := 8;
  49.       track[i,5].togo := 8;
  50.       track[i,6].togo := 10;
  51.       track[i,7].togo := 6;
  52.       track[i,8].togo := 6;
  53.       track[i,9].togo := 4;
  54.       track[i,10].togo := 4;
  55.       track[i,11].togo := 2;
  56.       track[i,12].togo := 2;
  57.       for j := 1 to maxhorses do
  58.          track[i,j].horseloc := 0
  59.    end
  60. end;
  61.  
  62. procedure play (player : integer);
  63.  
  64. const
  65.    diemax = 6;
  66.  
  67. var
  68.    ch : char;
  69.    horsenum : integer;
  70.    poshorses : set of 1..12;
  71.    die1, die2 : 1..diemax;
  72.  
  73. (*
  74.  * throwdie
  75.  * uses the random function to throw the dice.
  76.  *)
  77.  
  78. function throwdie: integer;
  79.  
  80. begin
  81.    throwdie := 1 + random(diemax)
  82. end;
  83.  
  84. (*
  85.  * print.
  86.  * displays the tracks.
  87.  *)
  88.  
  89. procedure print;
  90.  
  91. var
  92.    pnum : 1..maxplayer;
  93.    curhorse : 1..maxhorses;
  94.    length : 1..10;
  95.    sum : 1..10;
  96.  
  97. begin
  98.    for pnum := 1 to numplayers do
  99.    begin
  100.       writeln('Player number ',pnum);
  101.       for curhorse := 1 to maxhorses do
  102.       begin
  103.          writeln;
  104.          write(curhorse:2,' - ');
  105.          sum := track[pnum,curhorse].togo + track[pnum,curhorse].horseloc;
  106.          for length := 1 to sum do
  107.             if length = track[pnum,curhorse].horseloc then
  108.                write(' (*)')
  109.             else
  110.                write(' ( )')
  111.       end;
  112.       writeln;
  113.       writeln
  114.    end;
  115.    writeln
  116. end;  (* print *)
  117.  
  118. (*
  119.  * movehorse.
  120.  * increments horseloc and decrements togo
  121.  * to move the horse.
  122.  *)
  123.  
  124. procedure movehorse (player,horsenum : integer);
  125.  
  126. begin
  127.    track[player,horsenum].togo := track[player,horsenum].togo - 1;
  128.    track[player,horsenum].horseloc := track[player,horsenum].horseloc + 1;
  129.    win := (track[player,horsenum].togo = 0);
  130.    if win then
  131.    begin
  132.       writeln;
  133.       writeln('Congratulations player ',player);
  134.       writeln('Your horse ',horsenum,' has won the race!')
  135.    end;
  136. end;
  137.  
  138. begin (* play *)
  139.    write('Player number ',player,' ');
  140.    readln(ch);
  141.    if (ch='p') or (ch='P') then  (* player types a P to request
  142.                                     a display of the tracks *)
  143.    begin
  144.       print;
  145.       readln
  146.    end;
  147.    die1 := throwdie;
  148.    die2 := throwdie;
  149.    poshorses := [die1, die2, (die1 + die2)];
  150.    write('You rolled a ',die1,' and a ',die2);
  151.    writeln(' with a total of ',(die1 + die2));
  152.    write('Which do you want? ');
  153.    readln(horsenum);
  154.    while not (horsenum in poshorses) do
  155.    begin
  156.       writeln('Sorry, but only ',die1,', ',die2,', or ',(die1 + die2));
  157.       writeln(' is allowed.');
  158.       write('Which do you want? ');
  159.       readln(horsenum)
  160.    end;
  161.    if horsenum = (die1 + die2) then
  162.       movehorse (player, (die1 + die2))
  163.    else
  164.    begin
  165.       movehorse (player,die1);
  166.       if not win then
  167.          movehorse (player, die2)
  168.    end
  169. end;  (* play  *)
  170.  
  171. begin     (* main program  *)
  172.  
  173.    win := false;
  174.    getnumplayers;
  175.    maketracks;
  176.    curplayer := 1;
  177.    while not win do  (* win is set to true in procedure movehorse  *)
  178.    begin
  179.       randomize;
  180.       play (curplayer);
  181.       if curplayer = numplayers then
  182.          curplayer := 1  (* go back to the first player *)
  183.       else
  184.          curplayer := curplayer + 1  (* next player *)
  185.    end;
  186.    writeln;
  187.    writeln
  188. end.   (* horserace  *)
  189.